﻿Imports CrystalDecisions.CrystalReports.Engine

Module modGeneral

    ' Paramètres de l'application
    Public ctDSN_DEVFAC As String
    Public myConnect As New Odbc.OdbcConnection    'Objet qui définit la connexion ODBC
    Public myCommand As New Odbc.OdbcCommand       'Objet Command qui contient une requête SQL

    Public gUserCode As String                  ' code utilisateur connecté
    Public gUserNom As String                   ' nom utilisateur connecté
    Public gUserAcces As String                 ' role utilisateur connecté
    Public gSocieteCode As String
    Public gSocieteNom As String
    Public gNoDossier As Integer
    Public gCD_CLI As Integer
    Public gDate_debut As Date = Now         ' Date début de traitement
    Public gDate_fin As Date = Now           ' Date fin de traitement
    Public gImpBlanc As String
    Public gImpEntete As String

    Public Const ctPlanning = 0
    Public Const ctGestion = 4
    Public Const ctCompta = 8
    Public Const ctAdmin = 9

    Private szSQL As String
    Private rs As ADODB.Recordset = Nothing


    '---------------------------------------------------------------------
    ' This will clear the text in all text boxes on the passed control
    ' as well as any of its child controls. It is useful when having many
    ' TexBoxes on a form that are also in many different parent controls
    ' and you want to clear them all at once.
    '
    ' Example usage:
    '    ClearTextBoxes(Me)
    '---------------------------------------------------------------------
    Public Sub ClearTextBoxes(ByVal ctrl As Control)
        Dim c As Control

        For Each c In ctrl.Controls
            If c.HasChildren Then
                ClearTextBoxes(c)
            ElseIf TypeOf (c) Is TextBox Then
                c.Text = ""
            End If
        Next
    End Sub

    '-------------------------------------------------------------------------------------
    Public Function nv(ByVal c As Object) As Object
        ' remplace une chaine NULL en ""
        On Error Resume Next
        nv = vbNullString & c

    End Function

    Public Function nq(ByVal c As String) As String
        ' remplace les quotes par ''
        On Error Resume Next
        nq = Replace(c, "'", "\'")

    End Function

    Public Function ns(ByVal c As String) As String
        ' remplace les slash par \\
        On Error Resume Next
        ns = Replace(c, "\", "\\")

    End Function

    Public Function nz(ByVal c As Object) As Double
        If TypeOf c Is System.DBNull Then
            Return 0
        Else
            Return c
        End If
    End Function

    Public Function Zero2Space(ByVal montant As Decimal) As String
        ' renvoie espace si montant = zero
        If montant Then
            Zero2Space = montant.ToString
        Else
            Zero2Space = ""
        End If

    End Function

    Public Function IfDate(ByVal dDate As Object) As String
        ' renvoie espace si non date
        If IsDate(dDate) Then
            IfDate = Format(dDate, "dd/MM/yyyy")
        Else
            IfDate = ""
        End If

    End Function

    Public Function IfHeure(ByVal dHeure As Object) As String
        ' renvoie espace si non heure
        If IsDate(dHeure) Then
            IfHeure = Format(dHeure, "HH:mm")
        Else
            IfHeure = ""
        End If

    End Function

    Public Function IfDatetime(ByVal dDate As Object) As String
        ' renvoie espace si non date
        If IsDate(dDate) Then
            IfDatetime = Format(dDate, "dd/MM/yyyy HH:mm")
        Else
            IfDatetime = ""
        End If

    End Function

    ' Obtient le libellé dans une table par son code
    Public Function getLibelleByCode(ByVal NomTable As String, ByVal Code As Integer) As String

        ' Lire la table NomTable
        szSQL = "CALL spGet_P_TABLES_byCODE('" & NomTable & "'," & Code & ")"
        GetRecordset(ctDSN_DEVFAC, szSQL, rs)
        If rs.RecordCount > 0 Then
            If NomTable = "P_MODE_REGL" Then
                getLibelleByCode = rs.Fields("lib4").Value
            Else
                getLibelleByCode = rs.Fields("libelle").Value
            End If
        Else
            getLibelleByCode = ""
        End If
        rs.Close()
        rs = Nothing

    End Function

    Public Sub InitComboSocietes(ByVal combo As ComboBox)

        ' vider le combobox
        combo.Items.Clear()
        ' Lire la table SOCIETES
        szSQL = "CALL spGet_P_TABLES('P_SOCIETE')"
        GetRecordset(ctDSN_DEVFAC, szSQL, rs)
        Do While Not rs.EOF
            combo.Items.Add(rs.Fields("societe").Value)
            rs.MoveNext()
        Loop
        ' Close the recordset AND connection.
        rs.Close()
        combo.SelectedIndex = 0

    End Sub

    Public Function Calculer(ByVal pFormule As String) As Single
        ' calculer la pFormule
        Dim OP As String
        Dim Nombre As Single
        Dim Resultat As Single
        Dim i As Integer

        Calculer = 0
        Resultat = 0
        pFormule = UCase(pFormule)
        i = 0

        Resultat = GetNombre(pFormule, i)
        If Resultat = 0 Then
            Exit Function
        End If

        Do While i <= Len(pFormule) - 1
            OP = GetOper(pFormule, i)
            If OP = "" Then
                Exit Do
            End If
            Nombre = GetNombre(pFormule, i)
            If Nombre = 0 Then
                Exit Do
            End If
            ' calculer l'expression
            Select Case OP
                Case "*"
                    Resultat = Resultat * Nombre
                Case "/"
                    Resultat = Resultat / Nombre
            End Select
        Loop
        Calculer = Resultat

    End Function

    Public Sub InitComboModeRegle(ByVal combo As ComboBox)

        ' vider le combobox
        combo.Items.Clear()
        ' Lire la table MODE REGLE
        szSQL = "CALL spGET_P_MODEREG(-1)"
        GetRecordset(ctDSN_DEVFAC, szSQL, rs)
        Do While Not rs.EOF
            combo.Items.Add(rs.Fields("code").Value & " | " & rs.Fields("lib").Value)
            rs.MoveNext()
        Loop
        ' Close the recordset AND connection.
        rs.Close()
        combo.SelectedIndex = 0

    End Sub
    Public Sub InitComboQualite(ByVal combo As ComboBox)

        ' vider le combobox
        combo.Items.Clear()
        ' Lire la table Qualités
        szSQL = "CALL spGet_P_TABLES('P_QUALITE')"
        GetRecordset(ctDSN_DEVFAC, szSQL, rs)
        Do While Not rs.EOF
            combo.Items.Add(rs.Fields("code").Value)
            rs.MoveNext()
        Loop
        ' Close the recordset AND connection.
        rs.Close()
        combo.SelectedIndex = 0

    End Sub

    Public Sub InitComboCabinets(ByVal combo As ComboBox)

        ' vider le combobox
        combo.Items.Clear()
        ' Lire la table P_FAMILLE
        szSQL = "CALL spGET_CABINETbyNom('" & gSocieteCode & "','%')"
        GetRecordset(ctDSN_DEVFAC, szSQL, rs)
        Do While Not rs.EOF
            combo.Items.Add(rs.Fields("nom").Value & " | " & rs.Fields("code").Value)
            rs.MoveNext()
        Loop
        ' Close the recordset AND connection.
        rs.Close()
        combo.SelectedIndex = 0

    End Sub

    Public Sub InitComboExperts(ByVal combo As ComboBox, ByVal pCabinet As Integer)

        ' vider le combobox
        combo.Items.Clear()
        ' Lire la table P_FAMILLE
        szSQL = "CALL spGet_EXPERTS('" & gSocieteCode & "'," & pCabinet & ",-1)"
        GetRecordset(ctDSN_DEVFAC, szSQL, rs)
        Do While Not rs.EOF
            combo.Items.Add(rs.Fields("nom").Value & " | " & rs.Fields("code_exp").Value)
            rs.MoveNext()
        Loop
        ' Close the recordset AND connection.
        rs.Close()
        If combo.Items.Count > 0 Then
            combo.SelectedIndex = 0
        End If

    End Sub

    Public Sub InitComboTables(ByVal combo As ComboBox, ByVal pTable As String)

        ' vider le combobox
        combo.Items.Clear()
        ' Lire la table P_FAMILLE
        szSQL = "CALL spGet_P_TABLES('" & pTable & "')"
        GetRecordset(ctDSN_DEVFAC, szSQL, rs)
        Do While Not rs.EOF
            combo.Items.Add(rs.Fields("code").Value & " | " & rs.Fields("lib").Value)
            rs.MoveNext()
        Loop
        ' Close the recordset AND connection.
        rs.Close()
        combo.SelectedIndex = 0

    End Sub

    Public Sub InitComboTVA(ByVal combo As ComboBox)

        ' vider le combobox
        combo.Items.Clear()
        ' Lire la table TVA
        szSQL = "CALL spGet_P_TVA_byCODE(0);"
        GetRecordset(ctDSN_DEVFAC, szSQL, rs)
        Do While Not rs.EOF
            combo.Items.Add(rs.Fields("code").Value & " | " & rs.Fields("taux").Value & " %")
            rs.MoveNext()
        Loop
        ' Close the recordset AND connection.
        rs.Close()
        combo.SelectedIndex = 0

    End Sub

    Public Sub InitComboAgenda(ByVal combo As ComboBox)

        ' vider le combobox
        combo.Items.Clear()
        ' Lire la table TVA
        szSQL = "CALL spGET_AGENDAS('A')"
        GetRecordset(ctDSN_DEVFAC, szSQL, rs)
        Do While Not rs.EOF
            combo.Items.Add(rs.Fields("code").Value & " | " & rs.Fields("nom").Value)
            rs.MoveNext()
        Loop
        ' Close the recordset AND connection.
        rs.Close()
        combo.SelectedIndex = 0

    End Sub

    Public Sub InitComboJournal(ByVal combo As ComboBox)

        ' vider le combobox
        combo.Items.Clear()
        ' Lire la table JOURNAL
        szSQL = "CALL spGET_P_JOURNAUX('')"
        GetRecordset(ctDSN_DEVFAC, szSQL, rs)
        Do While Not rs.EOF
            combo.Items.Add(rs.Fields("code").Value & " | " & rs.Fields("compte").Value)
            rs.MoveNext()
        Loop
        ' Close the recordset AND connection.
        rs.Close()
        combo.SelectedIndex = 0

    End Sub

    ' Obtient le code situé derrière le libellé dans une combo 
    Public Function getTailCodeFromCombo(ByVal Libelle As String) As String
        Dim ix As Integer

        ' recherche le séparateur
        ix = InStr(Libelle, "|")
        If ix > 0 Then
            getTailCodeFromCombo = Trim(Mid(Libelle, ix + 1, Libelle.Length))
        Else
            getTailCodeFromCombo = ""
        End If

    End Function

    ' Obtient la position du code situé derrière le libellé dans une combo 
    Public Function getTailCodePosition(ByVal combo As ComboBox, code As Integer) As Integer
        Dim ix As Integer

        getTailCodePosition = 0
        For ix = 0 To combo.Items.Count - 1
            combo.SelectedIndex = ix
            If code = getTailCodeFromCombo(combo.SelectedItem) Then
                getTailCodePosition = ix
                Exit Function
            End If
        Next

    End Function

    ' Obtient le code par son libellé dans une combo 
    Public Function getCodeFromCombo(ByVal Libelle As String) As String
        Dim ix As Integer

        ' recherche le séparateur
        ix = InStr(Libelle, "|")
        If ix > 0 Then
            getCodeFromCombo = Trim(Mid(Libelle, 1, ix - 1))
        Else
            getCodeFromCombo = ""
        End If

    End Function

    Public Sub SortListView(ByVal lvw As ListView, ByRef oldColumn As ColumnHeader, ByVal newColumnIndex As Integer)

        ' Get the new sorting column.
        Dim newColumn As ColumnHeader = lvw.Columns(newColumnIndex)
        ' Figure out the new sorting order.
        Dim sort_order As System.Windows.Forms.SortOrder
        If newColumn Is Nothing Then
            ' New column. Sort ascending.
            sort_order = SortOrder.Ascending
        Else ' See if this is the same column.
            If newColumn.Equals(oldColumn) Then
                ' Same column. Switch the sort order.
                If oldColumn.Text.StartsWith("> ") Then
                    sort_order = SortOrder.Descending
                Else
                    sort_order = SortOrder.Ascending
                End If
            Else
                ' New column. Sort ascending.
                sort_order = SortOrder.Ascending
            End If
            ' Remove the old sort indicator.
            If Not oldColumn Is Nothing Then
                oldColumn.Text = oldColumn.Text.Substring(2)
            End If

        End If
        ' Display the new sort order.
        oldColumn = newColumn
        If sort_order = SortOrder.Ascending Then
            oldColumn.Text = "> " & oldColumn.Text
        Else
            oldColumn.Text = "< " & oldColumn.Text
        End If
        ' Create a comparer and sort
        lvw.ListViewItemSorter = New clsListViewSorter(newColumnIndex, sort_order)
        lvw.Sort()

    End Sub

    Public Function deleteEnregistrement(ByVal NomTable As String, ByVal Libelle As String, ByVal Cle As String, _
                 Optional ByVal cle2 As String = "", Optional ByVal cle3 As String = "", Optional ByVal cle4 As String = "", Optional ByVal cle5 As String = "") As Boolean

        deleteEnregistrement = False
        ' suppression d'un enregistrement
        If MessageBox.Show("Etes-vous sûr de vouloir supprimer " & Libelle & " ?", "Confirmation de la suppression", _
                            MessageBoxButtons.OKCancel, MessageBoxIcon.Question) = Windows.Forms.DialogResult.OK Then
            If Cle.Length = 0 Then
                MsgBox("Veuillez sélectionner d'abord un élément.")
                Exit Function
            End If

            szSQL = "CALL spDel_" & NomTable & " ('" & gSocieteCode & "','" & Cle
            If cle2 <> "" Then
                szSQL = szSQL & "','" & cle2
            End If
            If cle3 <> "" Then
                szSQL = szSQL & "','" & cle3
            End If
            If cle4 <> "" Then
                szSQL = szSQL & "','" & cle4
            End If
            If cle5 <> "" Then
                szSQL = szSQL & "','" & cle5
            End If
            szSQL = szSQL & "')"
            If ExecQuery(ctDSN_DEVFAC, szSQL) Then
                deleteEnregistrement = True
            End If
        End If
    End Function

    Public Sub setIndice(ByVal i As Integer, ByRef liste As ListView)
        ' borner l'indice par le nb d'éléments de la liste
        If i >= liste.Items.Count Then
            i = liste.Items.Count - 1
        End If

        ' puis sélectionner la ligne i
        If liste.Items.Count > 0 Then
            liste.Select()
            liste.Items(i).Selected = True
            liste.Items(i).Focused = True
            liste.Items(i).EnsureVisible()
        End If
    End Sub

    Public Function getDossierRoot() As String
        ' retourne le nom du dossier racine
        Dim szPath As String

        szPath = My.Application.Info.DirectoryPath
        getDossierRoot = szPath.Substring(0, InStr(4, szPath, "\"))

    End Function

    Public Function GetLibST(ByVal iStatus As Integer) As String
        Select Case iStatus
            Case 0
                GetLibST = "En-Cours"
            Case 10
                GetLibST = "Edité"
            Case 20
                GetLibST = "Facturé"
            Case 50
                GetLibST = "Facturée"
            Case 60
                GetLibST = "Réglée"
            Case Else
                GetLibST = "???..."
        End Select

    End Function

    Function LibByCode(Stab As String, Scod As String) As String
        ' retourne le libelle d'une table
        ' l'access est de type lecture, limité au champ Libellé

        'On Error GoTo libByCode_err
        LibByCode = ""
        If Len(Scod) < 1 Then Exit Function

        szSQL = "SELECT lib FROM " & Stab & " WHERE code=" & Scod
        Call GetRecordset(ctDSN_DEVFAC, szSQL, rs)
        If rs.RecordCount > 0 Then
            LibByCode = nv(rs.Fields("Lib").Value)
        End If
        rs.Close()
        Exit Function

libByCode_err:
        MsgBox("Erreur de table : " + Stab, vbCritical)
        Resume Next

    End Function

    '-----------------------------
    ' affiche Entete commune
    '-----------------------------
    Public Function fAdresseClient(rsClient As ADODB.Recordset) As String

        ' affiche Adresse Client
        fAdresseClient = nv(rsClient.Fields("adresse").Value) & vbCrLf & _
                nv(rsClient.Fields("adresse2").Value) & vbCrLf & _
                nv(rsClient.Fields("cp").Value) & "  " & nv(rsClient.Fields("ville").Value)

    End Function

    Public Sub InitListeLettres(lv_lettres As ListView, ByVal ix As Integer)

        Dim nb As Integer = 0

        ' effacer la listview,
        lv_lettres.Items.Clear()
        lv_lettres.ListViewItemSorter = Nothing

        ' Lire la table LETTRES_TYPE
        szSQL = "CALL spGET_LETTRE('')"
        GetRecordset(ctDSN_DEVFAC, szSQL, rs)

        Do While Not rs.EOF
            lv_lettres.Items.Add(rs.Fields("ref").Value)
            lv_lettres.Items(nb).SubItems.Add(rs.Fields("libelle").Value)
            lv_lettres.Items(nb).SubItems.Add(rs.Fields("corps").Value)
            rs.MoveNext()
            nb = nb + 1
        Loop
        ' Close the recordset AND connection.
        rs.Close()

        ' restaurer la position du curseur avant le init
        setIndice(ix, lv_lettres)

    End Sub

    Public Sub CreerLettre(ByVal pRubrique As String, ByVal pNoDossier As Integer, ByVal pRef As String, ByVal pDate As String)

        Dim szType As String = ""

        Select Case pRubrique
            Case "DEM_DEVIS"
                szType = "DD"
            Case "ORDRES"
                szType = "OS"
            Case "RDVOUS"
                szType = "RV"
        End Select

        ' supprimer la lettre dans fichier temporaire
        szSQL = "CALL spDEL_T_TABLE('T_LETTRE','" & gUserCode & "')"
        ExecQuery(ctDSN_DEVFAC, szSQL)
        ' créer la nouvele lettre
        szSQL = "CALL spINS_T_LETTRE('" & gUserCode & "','" & gSocieteCode & "','" & pRef & "','" & szType & "','" & pDate & "'," & _
                 pNoDossier & ")"
        ExecQuery(ctDSN_DEVFAC, szSQL)

    End Sub

    Public Sub Perform_tab_on_enter(ByVal e As KeyEventArgs)
        If e.KeyCode = Keys.Enter Then
            SendKeys.Send("{TAB}")
        Else
            Exit Sub
        End If
        e.SuppressKeyPress = True 'this will prevent ding sound 
    End Sub

    Public Function setModifiedBy(ByVal cree_le As Date, modif_le As Date, user As String) As String
        setModifiedBy = "Créé le " & Format(cree_le, "dd/MM/yy HH:mm") & ",  modifié le " & Format(modif_le, "dd/MM/yy HH:mm") & "  par " & user
    End Function

    Public Sub PrintToPrinter(ByVal szReportName As String, ByVal szFormula As String, ByVal szPrinterName As String)

        ' selectionner une imprimante

        ' OUVERTURE du REPORT
        Dim rpt As New ReportDocument
        Try
            rpt.Load(My.Settings.DossierRoot & "REPORT\" & szReportName)
        Catch ex As Exception
            MsgBox(ex.Message & " : " & vbCrLf & szReportName, vbCritical)
            Exit Sub
        End Try
        ' définir la sélection
        If szFormula.Length > 0 Then
            rpt.RecordSelectionFormula = szFormula
        End If

        rpt.PrintOptions.PrinterName = "\\" & szPrinterName
        rpt.PrintToPrinter(1, False, 0, 0)
        rpt.Close()

    End Sub

    Public Function getLundiPrecedent(ByVal Jour As Date) As Date

        ' On calcule le lundi précédent la date Jour
        getLundiPrecedent = Jour.AddDays(-(Weekday(Jour) - vbMonday))
        getLundiPrecedent = getLundiPrecedent.Date

    End Function

    Public Function IsHoliday(ByVal Jour As Date) As Boolean
        Dim var1, var2, var3, var4, var5, var6, var7 As Integer
        Dim annee As Integer
        Dim paques As Date

        IsHoliday = True

        ' dimanche ?
        If Weekday(Jour) = 1 Then
            Exit Function
        End If

        ' jours fériées fixes ?
        If (Jour.Day = 1 And Jour.Month = 1) Or (Jour.Day = 1 And Jour.Month = 5) Or _
              (Jour.Day = 8 And Jour.Month = 5) Or (Jour.Day = 14 And Jour.Month = 7) Or _
              (Jour.Day = 15 And Jour.Month = 8) Or (Jour.Day = 1 And Jour.Month = 11) Or _
              (Jour.Day = 11 And Jour.Month = 11) Or (Jour.Day = 25 And Jour.Month = 12) Then
            Exit Function
        End If
        ' détermination de Paques
        annee = Year(Jour)
        var1 = annee Mod 19 + 1
        var2 = (annee \ 100) + 1
        var3 = ((3 * var2) \ 4) - 12
        var4 = (((8 * var2) + 5) \ 25) - 5
        var5 = ((5 * annee) \ 4) - var3 - 10
        var6 = (11 * var1 + 20 + var4 - var3) Mod 30

        If (var6 = 25 And var1 > 11) Or (var6 = 24) Then
            var6 = var6 + 1
        End If

        var7 = 44 - var6
        If var7 < 21 Then
            var7 = var7 + 30
        End If
        var7 = var7 + 7
        var7 = var7 - (var5 + var7) Mod 7

        If var7 <= 31 Then
            paques = DateValue(CStr(var7) & "/3/" & CStr(annee))
        Else
            paques = DateValue(CStr(var7 - 31) & "/4/" & CStr(annee))
        End If
        If DateDiff(DateInterval.Day, paques, Jour) = 1 Then    ' = lundi de paques
            Exit Function
        End If
        If DateDiff(DateInterval.Day, paques, Jour) = 39 Then   ' = ascension
            Exit Function
        End If
        If DateDiff(DateInterval.Day, paques, Jour) = 50 Then   ' = pentecote
            Exit Function
        End If

        IsHoliday = False

    End Function

    Public Function Show_Dossier(ByVal szRubrique As String, ByVal noDossier As Integer)

        Show_Dossier = noDossier
        ' afficher les détails 
        Select Case szRubrique
            Case "DD"
                frmDemandeDevis.pRubrique = "DEM_DEVIS"
                frmDemandeDevis.pNoDossier = noDossier
                frmDemandeDevis.ShowDialog()
                Show_Dossier = frmDemandeDevis.pNoDossier
            Case "RV"
                frmDemandeDevis.pRubrique = "RDVOUS"
                frmDemandeDevis.pNoDossier = noDossier
                frmDemandeDevis.ShowDialog()
                Show_Dossier = frmDemandeDevis.pNoDossier
            Case "OS"
                frmOrdreService.pNoDossier = noDossier
                frmOrdreService.ShowDialog()
                Show_Dossier = frmOrdreService.pNoDossier
            Case "DE"
                frmDevis.pRubrique = "DEVIS"
                frmDevis.pNoDossier = noDossier
                frmDevis.ShowDialog()
                Show_Dossier = frmDevis.pNoDossier
            Case "PF"
                frmDevis.pRubrique = "PROFORMA"
                frmDevis.pNoDossier = noDossier
                frmDevis.ShowDialog()
                Show_Dossier = frmDevis.pNoDossier
            Case "FA"
                frmFacture.pNoDossier = noDossier
                frmFacture.ShowDialog()
                Show_Dossier = frmFacture.pNoDossier
        End Select

    End Function

    Public Function getAgrementbyTarif(ByVal noTarif As Integer) As String

        ' pas d'agrement
        getAgrementbyTarif = ""

        If noTarif > 1 Then
            'lire le no tarif pour avoir le no agrement
            szSQL = "CALL spGET_P_TARIFS('" & gSocieteCode & "'," & noTarif & ")"
            GetRecordset(ctDSN_DEVFAC, szSQL, rs)
            If rs.RecordCount > 0 Then
                getAgrementbyTarif = nv(rs.Fields("no_agrement").Value)
            End If
            rs.Close()
        End If

    End Function

    Public Function getSocieteColor() As System.Drawing.Color
        Select Case gSocieteCode
            Case "PE"
                getSocieteColor = Color.LemonChiffon
            Case "ME"
                getSocieteColor = Color.LightSalmon
            Case "PO"
                getSocieteColor = Color.LightBlue
            Case "PL"
                getSocieteColor = Color.LightGreen
            Case Else
                getSocieteColor = Color.LightYellow
        End Select
    End Function

    Private Function GetNombre(ByVal szFormule As String, ByRef i As Integer) As Double
        ' extraire un nombre
        Dim element As String
        Dim car As String

        element = ""
        Call EliminerSpace(szFormule, i)
        Do While i <= Len(szFormule) - 1
            car = szFormule.Substring(i, 1)
            If car = "(" Or car = ")" Then      ' ignorer (
                ' i = i + 1
            Else
                ' si caractère autre que 0 à 9,  ou - . / ,
                If (Asc(car) < 44 Or Asc(car) > 57) Then
                    Exit Do
                End If
                If car = "/" Then     ' ignorer /
                    Exit Do
                End If
                element = Trim(element) & car     ' rajouter au élément
            End If
            i = i + 1
        Loop
        ' element = Replace(element, ".", ",")
        If IsNumeric(element) Then
            GetNombre = CDec(element)
        Else
            GetNombre = 0
        End If

    End Function

    Private Sub EliminerSpace(ByVal szFormule As String, ByRef i As Integer)
        ' élimine espace devant
        Dim car As String

        Do While i <= Len(szFormule) - 1
            car = szFormule.Substring(i, 1)
            If car = " " Or car = "(" Or car = ")" Then
                i = i + 1
            Else
                Exit Do
            End If
        Loop

    End Sub

    Function GetOper(ByVal szFormule As String, ByRef i As Integer) As String
        ' get un opérateur
        Dim car As String

        GetOper = ""
        Call EliminerSpace(szFormule, i)
        Do While i <= Len(szFormule) - 1
            car = szFormule.Substring(i, 1)
            ' si caractère est * ou /
            If car = "*" Or car = "/" Then
                GetOper = car
                i = i + 1
            End If
            Exit Do
        Loop

    End Function

    Public Function IsUserAuthorised(ByVal code As Integer) As Boolean
        ' utilisateur autorisé à effectuer ?
        If gUserAcces < code Then
            MsgBox("Désolé, vous n'avez pas le niveau requis (" & code & ") pour effectuer cette opération !", _
                    MsgBoxStyle.Critical, "CONTROLE D'ACCES")
            IsUserAuthorised = False
        Else
            IsUserAuthorised = True
        End If

    End Function



End Module
